home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0002_Anangram Sort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  24.9 KB  |  651 lines
  1.  (* Start of PART 1 of 7 *)
  2.  
  3. (***********************************************************************
  4.           Contest 3 Entry : Anagram Sort by Guy McLoughlin
  5.           Compiler        : Borland Pascal 7.0
  6. ***********************************************************************)
  7.  
  8.  {.$DEFINE DebugMode}
  9.  
  10.  {$IFDEF DebugMode}
  11.    {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P-,Q+,R+,S+,T+,V+,X-}
  12.  {$ELSE}
  13.    {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  14.  {$endIF}
  15.  
  16.  {$M 16384,374784,655360}
  17.  
  18. Program Anagram_Sort;
  19.  
  20. Const
  21.   co_MaxWord  =  2500;
  22.   co_MaxSize  = 65519;
  23.   co_SafeSize = 64500;
  24.  
  25. Type
  26.   Char_12 = Array[1..12] of Char;
  27.  
  28.   st_4    = String[4];
  29.   st_10   = String[10];
  30.   st_80   = String[80];
  31.  
  32.   byar_26 = Array[97..122] of Byte;
  33.  
  34.   po_Buff     = ^byar_Buffer;
  35.   byar_Buffer = Array[1..co_MaxSize] of Byte;
  36.  
  37.   porc_Word = ^rc_Word;
  38.   rc_Word   = Record
  39.                 wo_Pos    : Word;
  40.                 ar_LtrChk : Char_12;
  41.                 st_Word   : st_10
  42.               end;
  43.  
  44.   poar_Word     = Array[0..co_MaxWord] of porc_Word;
  45.  
  46.   porc_AnaGroup = ^rc_AnaGroup;
  47.   rc_AnaGroup   = Record
  48.                     wo_Pos   : Word;
  49.                     st_Group : st_80
  50.                   end;
  51.  
  52.   poar_AnaGroup = Array[0..co_MaxWord] of porc_AnaGroup;
  53.   poar_Generic  = Array[0..co_MaxWord] of Pointer;
  54.  
  55.   (***** Check For I/O errors.                                        *)
  56.   (*                                                                  *)
  57.   Procedure CheckIOerror;
  58.   Var
  59.     by_Error : Byte;
  60.   begin
  61.     by_Error := ioresult;
  62.     if (by_Error <> 0) then
  63.       begin
  64.         Writeln('Input/Output error = ', by_Error);
  65.         halt
  66.       end
  67.   end;        (* CheckIOerror.                                        *)
  68.  
  69.   (***** Display HEAP error message.                                  *)
  70.   (*                                                                  *)
  71.   Procedure HeapError;
  72.   begin
  73.     Writeln('Insuficient free HEAP memory');
  74.     halt
  75.   end;        (* HeapError.                                        *)
  76.  
  77. Type
  78.   Item     = Pointer;
  79.   ar_Item  = poar_Generic;
  80.   CompFunc = Function(Var Item1, Item2 : Item) : Boolean;
  81.  
  82.  (* end of PART 1 of 7 *)
  83.  (* Start of PART 2 of 7 *)
  84.  
  85.   (***** QuickSort routine.                                           *)
  86.   (*                                                                  *)
  87.   Procedure QuickSort({update} Var ar_Data  : ar_Item;
  88.                       {input }     wo_Left,
  89.                                    wo_Right : Word;
  90.                                    LessThan : CompFunc);
  91.   Var
  92.     Pivot,
  93.     TempItem : Item;
  94.     wo_Index1,
  95.     wo_Index2 : Word;
  96.   begin
  97.     wo_Index1 := wo_Left;
  98.     wo_Index2 := wo_Right;
  99.     Pivot := ar_Data[(wo_Left + wo_Right) div 2];
  100.     Repeat
  101.       While LessThan(ar_Data[wo_Index1], Pivot) do
  102.         inc(wo_Index1);
  103.       While LessThan(Pivot, ar_Data[wo_Index2]) do
  104.         dec(wo_Index2);
  105.       if (wo_Index1 <= wo_Index2) then
  106.         begin
  107.           TempItem := ar_Data[wo_Index1];
  108.           ar_Data[wo_Index1] := ar_Data[wo_Index2];
  109.           ar_Data[wo_Index2] := TempItem;
  110.           inc(wo_Index1);
  111.           dec(wo_Index2)
  112.         end
  113.       Until (wo_Index1 > wo_Index2);
  114.       if (wo_Left < wo_Index2) then
  115.         QuickSort(ar_Data, wo_Left, wo_Index2, LessThan);
  116.       if (wo_Index1 < wo_Right) then
  117.         QuickSort(ar_Data, wo_Index1, wo_Right, LessThan)
  118.   end;        (* QuickSort.                                           *)
  119.  
  120.   (***** Sort Function to check if anagram-Word's are in sorted order *)
  121.   (*                                                                  *)
  122.   Function AlphaSort(Var Item1, Item2 : Item) : Boolean; Far;
  123.   begin
  124.     AlphaSort := (porc_Word(Item1)^.st_Word < porc_Word(Item2)^.st_Word)
  125.   end;        (* AlphaSort.                                           *)
  126.  
  127.   (***** Sort Function to check:                                      *)
  128.   (*                                                                  *)
  129.   (*        1 - If anagram-Words are sorted by length.                *)
  130.   (*        2 - If anagram-Words are sorted by anagram-group.         *)
  131.   (*        3-  If anagram-Words are sorted alphabeticly.             *)
  132.   (*                                                                  *)
  133.   Function Sort1(Var Item1, Item2 : Item) : Boolean; Far;
  134.   begin
  135.     if (porc_Word(Item1)^.st_Word[0] <>
  136.                                       porc_Word(Item2)^.st_Word[0]) then
  137.       Sort1 := (porc_Word(Item1)^.st_Word[0] <
  138.                                            porc_Word(Item2)^.st_Word[0])
  139.     else
  140.       if (porc_Word(Item1)^.ar_LtrChk <>
  141.                                        porc_Word(Item2)^.ar_LtrChk) then
  142.         Sort1 := (porc_Word(Item1)^.ar_LtrChk <
  143.                                             porc_Word(Item2)^.ar_LtrChk)
  144.       else
  145.         Sort1 := (porc_Word(Item1)^.wo_Pos < porc_Word(Item2)^.wo_Pos)
  146.   end;        (* Sort1.                                               *)
  147.  
  148.   (***** Sort Function to check:                                      *)
  149.   (*                                                                  *)
  150.   (*     If anagram-group Strings are sorted alphabeticly.            *)
  151.   (*                                                                  *)
  152.   Function Sort2(Var Item1, Item2 : Item) : Boolean; Far;
  153.   begin
  154.     Sort2 := (porc_AnaGroup(Item1)^.wo_Pos <
  155.                                            porc_AnaGroup(Item2)^.wo_Pos)
  156.   end;        (* Sort2.                                               *)
  157.  
  158.  (* end of PART 2 of 7 *)
  159.  (* Start of PART 3 of 7 *)
  160.  
  161.   (***** Check if the anagram-Word table is in sorted order.          *)
  162.   (*                                                                  *)
  163.   Function TableSorted({input } Var ar_Data  : poar_Word;
  164.                                     wo_Left,
  165.                                     wo_Right : Word) : {output} Boolean;
  166.   Var
  167.     wo_Index : Word;
  168.   begin
  169.               (* Set Function result to True.                         *)
  170.     TableSorted := True;
  171.  
  172.               (* Loop through all but the last Word in the anagram-   *)
  173.               (* Word "table".                                        *)
  174.     For wo_Index := wo_Left to pred(wo_Right) do
  175.               (* Check if the current and next anagram-Words are not  *)
  176.               (* sorted.                                              *)
  177.       if (ar_Data[wo_Index]^.st_Word >
  178.                                 ar_Data[succ(wo_Index)]^.st_Word) then
  179.       begin
  180.               (* Set Function result to False, and break the "for"    *)
  181.               (* loop.                                                *)
  182.         TableSorted := False;
  183.         break
  184.       end
  185.   end;        (* TableSorted.                                         *)
  186.  
  187.   (***** Pack bits 0,1,2 of each Byte in 26 Byte Array into 10 Chars. *)
  188.   (*                                                                  *)
  189.   Procedure PackBits({input } Var byar_Temp : byar_26;
  190.                      {output} Var Char_Temp : Char_12);
  191.   begin
  192.     Char_Temp[ 1] := chr((byar_Temp[ 97] and $7) shl 5 +
  193.                          (byar_Temp[ 98] and $7) shl 2 +
  194.                          (byar_Temp[ 99] and $6) shr 1);
  195.     Char_Temp[ 2] := chr((byar_Temp[ 99] and $1) shl 7 +
  196.                          (byar_Temp[100] and $7) shl 4 +
  197.                          (byar_Temp[101] and $7) shl 1 +
  198.                          (byar_Temp[102] and $4) shr 2);
  199.     Char_Temp[ 3] := chr((byar_Temp[102] and $3) shl 6 +
  200.                          (byar_Temp[103] and $7) shl 3 +
  201.                          (byar_Temp[104] and $7));
  202.     Char_Temp[ 4] := chr((byar_Temp[105] and $7) shl 5 +
  203.                          (byar_Temp[106] and $7) shl 2 +
  204.                          (byar_Temp[107] and $6) shr 1);
  205.     Char_Temp[ 5] := chr((byar_Temp[107] and $1) shl 7 +
  206.                          (byar_Temp[108] and $7) shl 4 +
  207.                          (byar_Temp[109] and $7) shl 1 +
  208.                          (byar_Temp[110] and $4) shr 2);
  209.     Char_Temp[ 6] := chr((byar_Temp[110] and $3) shl 6 +
  210.                          (byar_Temp[111] and $7) shl 3 +
  211.                          (byar_Temp[112] and $7));
  212.     Char_Temp[ 7] := chr((byar_Temp[113] and $7) shl 5 +
  213.                          (byar_Temp[114] and $7) shl 2 +
  214.                          (byar_Temp[115] and $6) shr 1);
  215.     Char_Temp[ 8] := chr((byar_Temp[115] and $1) shl 7 +
  216.                          (byar_Temp[116] and $7) shl 4 +
  217.                          (byar_Temp[117] and $7) shl 1 +
  218.                          (byar_Temp[118] and $4) shr 2);
  219.     Char_Temp[ 9] := chr((byar_Temp[118] and $3) shl 6 +
  220.                          (byar_Temp[119] and $7) shl 3 +
  221.                          (byar_Temp[120] and $7));
  222.     Char_Temp[10] := chr((byar_Temp[121] and $7) shl 5 +
  223.                          (byar_Temp[122] and $7) shl 2)
  224.   end;        (* PackBits.                                            *)
  225.  
  226. Var
  227.   po_Buffer       : po_Buff;
  228.  
  229.   by_Index,
  230.   by_LastAnagram,
  231.   by_CurrentWord  : Byte;
  232.  
  233.   wo_Index,
  234.   wo_ReadIndex,
  235.   wo_TableIndex,
  236.   wo_BufferIndex,
  237.   wo_CurrentIndex : Word;
  238.  
  239.  (* end of PART 3 of 7 *)
  240.  (* Start of PART 4 of 7 *)
  241.  
  242.   st_Temp         : st_4;
  243.  
  244.   byar_LtrChk     : byar_26;
  245.  
  246.   fi_Temp         : File;
  247.  
  248.   rcar_Table      : poar_Word;
  249.  
  250.   rcar_Groups     : poar_AnaGroup;
  251.  
  252.  
  253.               (* Main Program execution block.                        *)
  254. begin
  255.               (* If there is sufficient room, allocate the main data- *)
  256.               (* buffer on the HEAP.                                  *)
  257.   if (maxavail > co_MaxSize) then
  258.     new(po_Buffer)
  259.   else
  260.               (* Else, inform user of insufficient HEAP memory, and   *)
  261.               (* halt the Program.                                    *)
  262.     HeapError;
  263.  
  264.               (* Clear the data-buffer.                               *)
  265.   fillChar(po_Buffer^, co_MaxSize, 0);
  266.  
  267.               (* Initialize counter Variable.                         *)
  268.   wo_Index := 0;
  269.  
  270.               (* While the counter is less than co_MaxWord do...      *)
  271.   While (co_MaxWord > wo_Index) do
  272.  
  273.               (* If there is sufficient memory, allocate another      *)
  274.               (* anagram-Word Record on the HEAP.                     *)
  275.     if (maxavail > sizeof(rc_Word)) then
  276.       begin
  277.         inc(wo_Index);
  278.         new(rcar_Table[wo_Index]);
  279.         fillChar(rcar_Table[wo_Index]^, sizeof(rc_Word), 0);
  280.       end
  281.     else
  282.               (* Else, inform user of insufficient HEAP memory, and   *)
  283.               (* halt the Program.                                    *)
  284.       HeapError;
  285.  
  286.               (* Initialize counter Variable.                         *)
  287.   wo_Index := 0;
  288.  
  289.               (* While the counter is less than co_MaxWord do...      *)
  290.   While (co_MaxWord > wo_Index) do
  291.  
  292.               (* If there is sufficient memory, allocate another      *)
  293.               (* anagram-group String on the HEAP.                    *)
  294.     if (maxavail > sizeof(rc_AnaGroup)) then
  295.       begin
  296.         inc(wo_Index);
  297.         new(rcar_Groups[wo_Index]);
  298.         fillChar(rcar_Groups[wo_Index]^, sizeof(rc_AnaGroup), 32);
  299.       end
  300.     else
  301.               (* Else, inform user of insufficient HEAP memory, and   *)
  302.               (* halt the Program.                                    *)
  303.       HeapError;
  304.  
  305.               (* Attempt to open File containing the anagram-Words.   *)
  306.   assign(fi_Temp, 'WordLIST.DAT');
  307.  
  308.               (* Set Filemode to "read-only".                         *)
  309.   Filemode := 0;
  310.   {$I-}
  311.   reset(fi_Temp, 1);
  312.   {$I+}
  313.               (* Check For I/O errors.                                *)
  314.   if (ioresult <> 0) then
  315.     begin
  316.       Writeln('Error opening anagram data File ---> WordLIST.DAT');
  317.       halt
  318.     end;
  319.               (* Read-in the entire anagram list into the data-buffer *)
  320.   blockread(fi_Temp, po_Buffer^, co_MaxSize, wo_ReadIndex);
  321.  
  322.  (* end of PART 4 of 7 *)
  323.  (* Start of PART 5 of 7 *)
  324.  
  325.               (* Check For I/O errors.                                *)
  326.   CheckIOerror;
  327.  
  328.   close(fi_Temp);
  329.  
  330.               (* Check For I/O errors.                                *)
  331.   CheckIOerror;
  332.  
  333.               (* Initialize index Variables.                          *)
  334.   wo_TableIndex  := 0;
  335.   wo_BufferIndex := 0;
  336.  
  337.               (* Repeat...Until all data in the data-buffer has been  *)
  338.               (* processed.                                           *)
  339.   Repeat
  340.  
  341.               (* Repeat...Until a valid anagram-Word Character has    *)
  342.               (* been found, or the complete data-buffer has been     *)
  343.               (* processed.                                           *)
  344.     Repeat
  345.       inc(wo_BufferIndex)
  346.     Until ((po_Buffer^[wo_BufferIndex] > 96)
  347.       and (po_Buffer^[wo_BufferIndex] < 123))
  348.        or (wo_BufferIndex > wo_ReadIndex);
  349.  
  350.               (* If the complete data-buffer has been processed then  *)
  351.               (* break the Repeat...Until loop.                       *)
  352.     if (wo_BufferIndex > wo_ReadIndex) then
  353.       break;
  354.  
  355.               (* Advance the anagram-Word "table" index.              *)
  356.     inc(wo_TableIndex);
  357.  
  358.               (* Clear the "letter check" Byte-Array Variable.        *)
  359.     fillChar(byar_LtrChk, sizeof(byar_26), 0);
  360.  
  361.               (* Repeat...Until not an anagram-Word Character,  or    *)
  362.               (* complete data-buffer has been processed.             *)
  363.     Repeat
  364.  
  365.               (* With the current anagram-Word Record do...           *)
  366.       With rcar_Table[wo_TableIndex]^ do
  367.         begin
  368.               (* Record the number of each alphabetical Character in  *)
  369.               (* the anagram-Word.                                    *)
  370.           inc(byar_LtrChk[po_Buffer^[wo_BufferIndex]]);
  371.  
  372.               (* Advance the String length-Character.                 *)
  373.           inc(st_Word[0]);
  374.  
  375.               (* Add the current anagram-Word Character to anagram-   *)
  376.               (* Word String.                                         *)
  377.           st_Word[ord(st_Word[0])] :=
  378.                                     chr(po_Buffer^[wo_BufferIndex]);
  379.  
  380.               (* Advance the data-buffer index.                       *)
  381.           inc(wo_BufferIndex)
  382.  
  383.         end
  384.     Until (po_Buffer^[wo_BufferIndex] < 97)
  385.        or (po_Buffer^[wo_BufferIndex] > 122)
  386.        or (wo_BufferIndex > wo_ReadIndex);
  387.  
  388.               (* Pack bits 0,1,2 of each Character in "letter-check"  *)
  389.               (* Variable, to store Variable as 10 Char data. This    *)
  390.               (* reduces memory storage requirements by 16 Bytes For  *)
  391.               (* each anagram-Word, and makes data faster to sort.    *)
  392.     PackBits(byar_LtrChk, rcar_Table[wo_TableIndex]^.ar_LtrChk);
  393.  
  394.   Until (wo_BufferIndex > wo_ReadIndex);
  395.  
  396.               (* Check if the Array of anagram-Words in the "table"   *)
  397.               (* Array are sorted. If not then sort them.             *)
  398.   if not TableSorted(rcar_Table, 1, wo_TableIndex) then
  399.     QuickSort(poar_Generic(rcar_Table), 1, wo_TableIndex, AlphaSort);
  400.  
  401.               (* Record the position of all the anagram-Words on the  *)
  402.               (* "table" Array. This will be used as a faster sorting *)
  403.               (* index.                                               *)
  404.   For wo_Index := 1 to wo_TableIndex do
  405.     rcar_Table[wo_Index]^.wo_Pos := wo_Index;
  406.  
  407.  (* end of PART 5 of 7 *)
  408.   (* Start of PART 6 of 7 *)
  409.  
  410.               (* QuickSort the "table" of anagram Words, using Sort1  *)
  411.               (* routine.                                             *)
  412.   QuickSort(poar_Generic(rcar_Table), 1, wo_TableIndex, Sort1);
  413.  
  414.               (* Attempt to open a File to Write sorted data to.      *)
  415.   assign(fi_Temp, 'SORTED.DAT');
  416.   {$I-}
  417.   reWrite(fi_Temp, 1);
  418.  
  419.               (* Check For I/O errors.                                *)
  420.   CheckIOerror;
  421.  
  422.               (* Set the temporary String to ', ' + Cr + Lf.          *)
  423.   st_Temp := ', ' + #13#10;
  424.  
  425.               (* Reset the loop index.                                *)
  426.   wo_Index      := 1;
  427.  
  428.               (* Repeat...Until all anagram-Word on "table" Array are *)
  429.               (* processed.                                           *)
  430.   Repeat
  431.  
  432.               (* Reset the counter Variables.                         *)
  433.     by_LastAnagram := 0;
  434.     by_CurrentWord := 0;
  435.  
  436.               (* While the next anagram-Word belongs to the same      *)
  437.               (* anagram-group, advance the by_LastAnagram Variable.  *)
  438.     While (rcar_Table[(wo_Index + by_LastAnagram)]^.ar_LtrChk =
  439.               rcar_Table[succ(wo_Index + by_LastAnagram)]^.ar_LtrChk) do
  440.       inc(by_LastAnagram);
  441.  
  442.               (* Repeat...Until next anagram-Word is not in the same  *)
  443.               (* anagram group.                                       *)
  444.     Repeat
  445.  
  446.               (* With current anagram group do...                     *)
  447.       With rcar_Groups[(wo_Index + by_CurrentWord)]^ do
  448.         begin
  449.  
  450.               (* Move the first anagram-Word in "table" Array to the  *)
  451.               (* current anagram group-String.                        *)
  452.           move(rcar_Table[(wo_Index + by_CurrentWord)]^.st_Word[1],
  453.                st_Group[1], ord(rcar_Table[(wo_Index +
  454.                                          by_CurrentWord)]^.st_Word[0]));
  455.  
  456.               (* Set the length-Char of current anagram-String to 12. *)
  457.           st_Group[0] := #12;
  458.  
  459.               (* Record the first anagram-Word position.              *)
  460.           wo_Pos := rcar_Table[(wo_Index + by_CurrentWord)]^.wo_Pos;
  461.  
  462.               (* Loop from 0 to total number of anagrams in the group *)
  463.           For by_Index := 0 to by_LastAnagram do
  464.  
  465.               (* If the loop index is not equal the the current       *)
  466.               (* anagram-Word, then...                                *)
  467.             if (by_Index <> by_CurrentWord) then
  468.               begin
  469.  
  470.               (* Add the next anagram-Word to the anagram-String.     *)
  471.                 move(rcar_Table[(wo_Index + by_Index)]^.st_Word[1],
  472.                      st_Group[succ(length(st_Group))],
  473.                      ord(rcar_Table[(wo_Index +
  474.                                                by_Index)]^.st_Word[0]));
  475.  
  476.               (* Record the length of the anagram-Word added to the   *)
  477.               (* anagram-String.                                      *)
  478.                 inc(st_Group[0],
  479.                     ord(rcar_Table[(wo_Index +
  480.                                                by_Index)]^.st_Word[0]));
  481.  
  482.               (* If the current anagram-Word is not the last anagram- *)
  483.               (* Word of the anagram-group, and the loop-index is     *)
  484.               (* less than the last anagram-Word, or the loop-index   *)
  485.               (* is less than the 2nd to last anagram-Word in group   *)
  486.                 if ((by_CurrentWord <> by_LastAnagram) and
  487.                     (by_Index < by_LastAnagram))
  488.                 or (by_Index < pred(by_LastAnagram)) then
  489.                   begin
  490.  
  491.  (* end of PART 6 of 7 *)
  492.  (* Start of PART 7 of 7 *)
  493.  
  494.               (* Add the comma and space Character to anagram-String. *)
  495.                     move(st_Temp[1],
  496.                                    st_Group[succ(length(st_Group))], 2);
  497.                     inc(st_Group[0], 2)
  498.                   end
  499.               end;
  500.  
  501.               (* Add the CR + Lf to anagram String.                   *)
  502.           move(st_Temp[3], st_Group[succ(length(st_Group))], 2);
  503.           inc(st_Group[0], 2);
  504.  
  505.               (* Advance the currrent anagram-Word index.             *)
  506.           inc(by_CurrentWord)
  507.  
  508.         end
  509.     Until (by_CurrentWord > by_LastAnagram);
  510.  
  511.               (* Advance the anagram-group index by the current       *)
  512.               (* anagram-Word index.                                  *)
  513.     inc(wo_Index, by_CurrentWord);
  514.  
  515.   Until (wo_Index > wo_TableIndex);
  516.  
  517.               (* QuickSort the anagram-Strings, using Sort2.          *)
  518.   QuickSort(poar_Generic(rcar_Groups), 1, wo_TableIndex, Sort2);
  519.  
  520.               (* Initialize loop control Variable.                    *)
  521.   wo_CurrentIndex := 1;
  522.  
  523.               (* Repeat Until all the anagram Words in the "table"    *)
  524.               (* Array have been processed.                           *)
  525.   Repeat
  526.  
  527.               (* Initialize loop control Variable.                    *)
  528.     wo_BufferIndex := 1;
  529.  
  530.               (* Place all the anagram-Strings in the data-buffer.    *)
  531.     While (wo_CurrentIndex <= wo_TableIndex)
  532.     and   (wo_BufferIndex  < co_SafeSize) do
  533.       With rcar_Groups[wo_CurrentIndex]^ do
  534.         begin
  535.               (* Place current anagram-String in the data-buffer.     *)
  536.           move(st_Group[1], po_Buffer^[wo_BufferIndex],
  537.                                                       length(st_Group));
  538.  
  539.               (* Advance the data-buffer index by length of anagram-  *)
  540.               (* String.                                              *)
  541.           inc(wo_BufferIndex, length(st_Group));
  542.  
  543.               (* Advance current anagram-String index.                *)
  544.           inc(wo_CurrentIndex)
  545.  
  546.         end;
  547.  
  548.               (* Write the anagram Text data in the buffer to disk.   *)
  549.     blockWrite(fi_Temp, po_Buffer^[1], pred(wo_BufferIndex));
  550.  
  551.               (* Check For I/O errors.                                *)
  552.     CheckIOerror;
  553.  
  554.   Until (wo_CurrentIndex >= wo_TableIndex);
  555.  
  556.               (* Close the sorted anagram-Text File.                  *)
  557.   close(fi_Temp);
  558.  
  559.               (* Check For I/O errors.                                *)
  560.   CheckIOerror
  561.  
  562. end.
  563.  
  564.  (* end of PART 7 of 7 *)
  565. {  Hi, to All:
  566.  
  567.   ...I gather that the 3rd Programming contest (Anagram Word sort)
  568.   is officially over, and am now posting my entry's source-code.
  569.  
  570.   This Program should execute in well under 1 second on a 486-33
  571.   ram-disk. (It's about 3.21 sec on my 386sx-25) The final compiled
  572.   size of the .EXE is 7360 Bytes.
  573.  
  574.   ...I've commented the h*ll out of my source-code, so it's a bit
  575.   on the big side.
  576.  
  577.   ...Here is a "quick" run-down of how it works:
  578.  
  579.       1- Creates a 60K buffer on the HEAP.
  580.  
  581.       2- Creates an Array table to store all the anagram Words
  582.          and data about each Word, on the HEAP.
  583.  
  584.       3- Creates an Array of anagram-group Strings on the HEAP.
  585.  
  586.       4- Read the entire anagram-Word input File WordLIST.DAT
  587.          into the 60K buffer in 1 big chunk.
  588.  
  589.       5- Finds all the anagram-Words in the buffer, and assigns
  590.          their data to the anagram-Word table on the HEAP.
  591.  
  592.       6- Each letter of every anagram-Word is Recorded in an
  593.          Array of 26 Bytes. Then the first 3 bits of each of
  594.          the 26 Bytes is packed, so that this data can be
  595.          stored in a 10 Character Array in each anagram-Word
  596.          table Record. (The bits are packed to save space and
  597.          to make the sorting faster.) This method allows for
  598.          a maximum of 7 of the same letter in each Word, which
  599.          should be sufficient For this contest.
  600.  
  601.       7- The table of anagram Records is then checked to see if
  602.          the anagram-Words are in sorted order. (In this contest
  603.          the original input File is in sorted order.) If they are
  604.          not in sorted order, QuickSort is called to put the
  605.          Words (actually Pointers to the Words) in order.
  606.  
  607.       8- Now that the anagram-Words are in sorted order, their
  608.          position in the anagram-Word table is Recorded in a
  609.          position field within each anagram-Word Record.
  610.  
  611.       9- The table of anagram-Word Records is now sorted using
  612.          a multi-key QuickSort. This will sort the anagram-Word
  613.          Records by:
  614.                      1- Length of anagram-Word.
  615.                      2- Letters that each anagram-Word contains.
  616.                      3- Alphabeticly.
  617.  
  618.          ...This multi-key sort will establish the anagram groups,
  619.          and sort the members of each group alphabeticly.
  620.  
  621.      10- Open the sorted output File.
  622.  
  623.      11- Create N number of anagram-Strings from N mumber of anagram-
  624.          Words in each anagram-group. Keeping the anagram Words in
  625.          the String in sorted order.
  626.  
  627.      12- QuickSort the anagram-group Strings into alphabetical order.
  628.  
  629.      13- Place all the sorted anagram-group Strings back into the
  630.          60K buffer.
  631.  
  632.      14- Write the entire buffer to the SORTED.DAT File, and close
  633.          this File.
  634.  
  635.    NOTES: Well this is the first time I've figured out how to do
  636.           multi-key QuickSorts, which I wasn't sure was possible
  637.           at first.
  638.  
  639.           I also tried using a 32-bit CRC value to identify the
  640.           anagram-groups which ran even faster, but should not
  641.           be considered a "safe" method, as it's accuracy is only
  642.           guaranteed For 2-7 Character Words.
  643.  
  644.           File I/O and repetitive loops are usually the big speed
  645.           killers in these Types of contests, so I always try to
  646.           keep them to a minimum.
  647.  
  648.           ...My entry could possibly be tweaked further still,
  649.           but I've got a life. <g>
  650.  
  651. }